home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / objInit < prev    next >
Text File  |  1993-06-08  |  2KB  |  62 lines
  1. \ objInit words for Yerk
  2. \  1/07/86  cdn Split from Window
  3. \  8/06/86  cdn Eliminated actFW; never liked it anyway
  4. \ 10/25/91    rfl    moved screenbits to window
  5. \                added setscroll to sysinit, and grayrgn
  6.  
  7. \ ( -- addr len )  leave name of the startup document as a string
  8. : myDoc  finfo 12 + count ;
  9.  
  10. \ set appropriate state when fWind is activated
  11. \ : actFW   Decimal  initfont ;
  12.  
  13. : eventInit
  14.     $ c1ef set: fEvent        \ set for all events except autokey
  15.     <[ 4 ]> 'cfas    null-evt    mouse-evt    null-evt    key-evt
  16.     <[ 4 ]> 'cfas    null-evt    key-evt        upd-evt        disk-evt
  17.     <[ 4 ]> 'cfas    actv-evt    null-evt    null-evt    null-evt
  18.     <[ 4 ]> 'cfas    null-evt    null-evt    null-evt    OS-Evt
  19.     <[ 4 ]> 'cfas    null-evt    null-evt    null-evt    null-evt
  20.     <[ 3 ]> 'cfas    null-evt    null-evt    HL-Evt
  21.     put: fEvent
  22.     purge  rekey  +curs ;
  23.  
  24. \ Define system startup word that initializes all nucleus
  25. \ objects - fFcb, fEvent, fpRect, fWind
  26. : sysInit
  27.     filinit
  28.     'c key ' abort 16 + !    \ setup event driven key
  29. \    ' File 'c fFcb !        \ establish nucleus based objects - filinit does this
  30.     ' Event 'c fEvent !
  31.     ' Rect 'c fpRect !
  32.     ' Window 'c fWind !
  33.     <[ 4 ]> 'cfas null null cls null actions: fWind
  34.     myDoc title: fWind
  35.     grayRgn true setGrow: fWind
  36.     eventInit ;
  37.  
  38.  
  39. : clean2  alive: fWind IF set: fWind THEN  initfont clean1 upCase ;
  40.  
  41. : Demit sp@ 3+ 1  write: fFcb drop (emit) ;
  42. : Dtype 2dup      write: fFcb drop (type) ;
  43. : Dcr 13 sp@ 3+ 1 write: fFcb 2drop (cr) ;
  44.  
  45. : ErrLog
  46.     'c Demit -> emitvec
  47.     'c Dtype -> typevec
  48.     'c Dcr   -> crvec
  49.     " ErrLog" name: fFcb
  50.     create: fFcb 0=
  51.     IF    .s clean2
  52.         txType saveSig set: fFcb
  53.         close: fFcb drop
  54.     THEN
  55.     0 -> emitvec
  56.     0 -> typevec
  57.     0 -> crvec
  58. ;
  59.  
  60. 'c sysInit -> objInit
  61. 'c clean2 -> abortvec
  62.